home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Best of Shareware
/
Best of PC Windows Shareware 1.0 - Wayzata Technology (7111) (1993).iso
/
mac
/
ZIPPED
/
DOS
/
CAD_CAM
/
WCEDT202.ZIP
/
WC.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1992-08-29
|
30KB
|
903 lines
;;;**************************************************************************
;;; WC.LSP
;;; (C) 1992 by ELSA America, Inc.
;;;
;;; A part of the
;;; WCEDIT -- ADS Programable text editor.
;;;
;;; Conceived and implemented by:
;;; Walt Craig
;;; Oct 1991
;;;
;;;**************************************************************************
;;;
;;; WALT CRAIG PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. WALT CRAIG
;;; SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR
;;; FITNESS FOR A PARTICULAR USE. WALT CRAIG DOES NOT WARRANT THAT
;;; THE OPERATION OF THE PROGRAM WILL BE UNNINTERRUPTED OR ERROR FREE.
;;;
;;;**************************************************************************
;;;
;;; DESCRIPTION
;;;
;;; WC.LSP is the loader for WCEDIT. Upon loading, a configuration
;;; file is loaded. The function (WCconfig ) defineds
;;; the keys and (wc_setvar) sets various variables.
;;;
;;; System control is shared and passed between C:WC and WCEdit
;;; to provide a method in which to 'drive' WCEdit within AutoCAD.
;;;
;;; Note:
;;; Altering the functions C:WC, PROCESS or WCERR is not recommended.
;;;
;;;**************************************************************************
(if(not WCedit) ;If it's not already defined
(progn ;
(xload "WCedit") ;Then xload it in
)
)
;------------------ Main calling function -----------------------------------
(defun c:WC( / __lst__ __nme__)
(setq __nme__ (list 0 "")) ;Force to the loop to enter
(setq __olderr__ *error* *error* WCerr);Set the error to return to the editor
(while(and(listp __nme__)__nme__) ;While nme is a list with a value
(setq *error* WCerr) ;Set the error to return to the editor
(setq __nme__(WCedit)) ;Call the editor with no parameters
(if (and (listp __nme__) __nme__);If the exit code is a list with a value
(process __nme__) ;Then call the lisp routine 'process' sending the
) ;list of (scancode "lisp function name")
)
(setq *error* __olderr__) ;Kill errors from returning to the editor
; (graphscr) ;Remout this line if ya want.
(if (= (type __nme__) 'STR) ;If nme is a string then We'll run it!
(progn
(eval(list(read __nme__))) ;Run the routine
(command "script" "wcrld");If No errors , then we'll return
)
)
(prin1)
);End of WC program
;-------------------- Process function evaluator ----------------------------
;-------------------- __mykey__ is a global ---------------------------------
(defun process(__stuff__ / __name__) ;Figure out what to do
(setq __mykey__(car __stuff__)) ;This is scancode for the key you hit
(setq __name__(cadr __stuff__)) ;This is the name of the lisp func as a string
(if (not (listp (read __name__)))
(progn
(if (not(eval(read __name__))) ;Test to see if it is defined before evaluating
(WC_message (strcat "Function: " __name__ " is not defined!")0)
(eval(list(read __name__))) ;Run the routine
)
)
(progn
(eval(read __name__)) ;Run the routine
)
)
(prin1)
);End of the process routine
;---------------------- Wc error routine ------
(defun WCerr(msg) ;This is the error routine
(setq globalerr msg ;Save a copy of error to refer back to
*error* __olderr__
)
(if wcedit
(progn
(setvar "CMDECHO" 0)
(command "script" "wcrld")
(wc_message (strcat "AutoLISP *error*: " (strcase msg nil)) 0)
)
)
(prin1)
);End of the WCerr routine
;*********************** ALL Functions listed below may be modified ********
;******************* to suit your needs ************************************
(wcconfig "(wc_toggle \"TOCASE\")" 1.0 "Toggle case sensitivity")
;;;Deletes a window by a double key stroke action where the
;;;arrow key must coincide with the edge of a window to be
;;;deleted. This is used explicitly for the Brief configuration.
(defun delwin()
(setq way(nth 14 (wc_statistics)))
(if(/= way 0)
(progn
(wc_print "Select window edge to delete (use cursor).")
(setq a(wc_message "" 0))
)
)
(cond
((or (= way 1)(= way 2))
(if(or(= (wc_gname a) "Right")(= (wc_gname a) "Left"))
(wc_trigger "MAKE_ONE")
(wc_print "Edge does not have a window")
)
)
((or (= way 3)(= way 4))
(if(or(= (wc_gname a) "Up")(= (wc_gname a) "Down"))
(wc_trigger "MAKE_ONE")
(wc_print "Edge does not have a window")
)
)
(t
(wc_print "Edge does not have a window")
)
)
)
(wcconfig "delwin" 1.0 "Delete window edge")
;;;Opens a window by a double key stroke action where the
;;;arrow key determines the direction by which to open the
;;;window. Used explicitly by Brief.lsp.
(defun splitc()
(wc_print "Select side for new window (use cursor).")
(setq a(wc_message "" 0))
(cond
((or (= (wc_gname a) "Right")(= (wc_gname a) "Left"))
(wc_trigger "SPLIT_CENTER_U")
(wc_refresh 1)
)
((or (= (wc_gname a) "Up")(= (wc_gname a) "Down"))
(wc_trigger "SPLIT_CENTER_R")
(wc_refresh 1)
)
(t
(wc_print " ")
)
)
)
(wcconfig "splitc" 1.0 "Open window")
;;;This sets up the book markers for use with gbmark and sabmark.
(defun sbmark()
(setq __bmark(list
'(1 (nil nil))
'(2 (nil nil))
'(3 (nil nil))
'(4 (nil nil))
'(5 (nil nil))
)
)
)
;;;Jump to previously saved book mark <position in file>
(defun gbmark()
(if(not __Bmark)
(sbmark)
)
(setq j(wc_fetch_int "Go to Bookmark [1-5]: " 1 1))
(setq old (cadr(assoc j __bmark)))
(if (or (not( nth 0 old)) (not (nth 1 old)))
(progn
(wc_beep 5000.0 9000.0)
(wc_print "That Bookmark doesn't exist.")
)
(progn
(wc_row (nth 0 old))
(wc_col (nth 1 old))
(wc_refresh 1)
(wc_print (strcat "Bookmark "(itoa j)" restored."))
)
)
)
;;;Save bookmark <position in file>
(defun sabmark(/ old new)
(if(not __Bmark)
(sbmark)
)
(setq ky __mykey__)
(cond
((= __mykey__ (wc_gkey "Alt 1"))
(setq k 1)
)
((= __mykey__ (wc_gkey "Alt 2"))
(setq k 2)
)
((= __mykey__ (wc_gkey "Alt 3"))
(setq k 3)
)
((= __mykey__ (wc_gkey "Alt 4"))
(setq k 4)
)
((= __mykey__ (wc_gkey "Alt 5"))
(setq k 5)
)
(t (setq k nil))
)
(if k
(progn
(setq old (assoc k __bmark))
(setq new (list k (list (wc_row -1)(wc_col -1))))
(setq __bmark(subst new old __bmark))
(wc_print (strcat "Bookmark "(itoa k)" saved."))
)
)
)
(defun rem_spaces(str / i ch outstr)
(wc_trimends str)
)
;;;This is used to toggle the insert mode on/off
(defun togins()
(wc_toggle "INSERT_MODE")
)
;;;This simply returns the current/active file name.
(defun gcname()
(setq lst(wc_statistics)one(nth 0 lst)two (nth 1 lst)side(nth 14 lst))
(cond
((or (= side 0)(= side 2)(= side 4))
one
)
(t two)
)
)
;;;This function simply displays the current filename as a print.
(defun disp_fname()
(wc_print gcname)
(prin1)
)
;;;This will either bring up the file passed as the current file and
;;;return 't or nil if the file is not loaded into WCEdit.
(defun tog_to_name(name / i nbuffs)
(setq nbuffs(nth 13 (wc_statistics))i 0)
(setq name (strcase name nil));Make the case upper.
(setq name (rem_spaces name));REmove any trailing spaces
(while (and (< i nbuffs)(/= name (gcname)))
(wc_trigger "TOGGLE_FILE")
(setq i (+ 1 i))
)
(if( = name (gcname))
't
nil
)
)
;;;This will 'zap' the file called by name from WCEdit. WARNING! Use
;;;this function with care since it does not check for file upsets.
(defun zap_name(name)
(if(tog_to_name name)
(progn
(setq i(nth 18 (wc_statistics)))
(wc_trigger "TOGGLE_FILE")
(if(= i (nth 18 (wc_statistics)))
(progn
(wc_silent 0)
(wc_message "Attempted to delete last buffer!" 0)
(quit)
)
(wc_remove_buffer i)
)
)
(progn
(wc_silent 0)
(wc_message "Name does not exist!" 0)
(quit)
)
)
)
;;;This is just a little fun I've thrown in.
(defun shave()
(WC_message "Shave and a hair cut .... " 1)
(WC_shave)
(WC_refresh 1)
)
(wcconfig "shave" 1.0 "Shave and a Hair cut")
;;;Use this routine for file checking if needed. The routine
;;;will look to see if the file 'name' exists. If it does
;;;exist, then a message appears asking the user if he/she
;;;wants to overwrite. The function returns 't if ok to
;;;overwrite or nil for not ok.
(defun check_file(name)
(setq answer 't)
(if name
(progn
(if(findfile name)
(progn
(setq answer(WC_message "File exists! Overwrite? N" 0))
(if answer
(progn
(setq answer(WC_castchar answer))
(if(or(= answer "Y")(= answer "y"))
(setq answer 't)
(setq answer nil)
)
)
)
)
)
)
(setq answer nil)
)
answer
)
;;;Register the function 'CHECKOUT' to a key...this thing is the neatest
;;;little thing I've come with in a long time! Should sell it!
;;;After you've registered it to a key move the cursor to anything your
;;;curious about, <a variable, list, whatever>. Then hit the key you've
;;;registered it to and the message window will pull up with a little
;;;info about that thing...you'll love it!
(defun symstr(sym / fp a)
(princ sym(setq fp(open "$$TRASH.$@1" "w")))
(close fp)
(setq a(read-line(setq fp(open "$$TRASH.$@1" "r"))))
(close fp)
(eval a)
)
(defun checkout(/ value first thing pt)
;(setq pt(wc_prev_word))
(setq pt(wc_next_word))
(setq value(eval(read pt)) first(strcat "[" pt "]: "))
(cond
((= (type value) 'sym)
(setq thing (strcat first "SYM = "(symstr value)))
)
((= (type value) 'list)
(if pprint
(setq thing (pprint value nil) thing nil)
(setq thing (strcat first "LIST = "(symstr value)))
)
)
((= (type value) 'file)
(setq thing (strcat first "FILE = "(symstr value)))
)
((= (type value) 'subr)
(setq thing (strcat first "SUBR = "(symstr value)))
)
((= (type value) 'exsubr)
(setq thing (strcat first "EXSUBR = "(symstr value)))
)
((= (type value) 'PICKSET)
(setq thing (strcat first "PICKSET = "(symstr value)))
)
((= (type value) 'ENAME)
(setq thing (strcat first "ENAME = "(symstr value)))
)
((= (type value) 'PAGETB)
(setq thing (strcat first "PAGETB = "(symstr value)))
)
((= (type value) 'REAL)
(setq thing (strcat first "REAL = "(rtos value 2 2)))
)
((= (type value) 'INT)
(setq thing (strcat first "INT = "(itoa value)))
)
((= (type value) 'STR)
(setq thing (strcat first "STR = " "\"" value "\""))
)
((= (type value) nil)
(setq thing (strcat first "Is nil" ))
)
)
(if thing
(progn
(wc_stuffkey (wc_gkey "Home"))
(wc_fetch_string (strcat thing
"")
" Evaluates to: "
" Escape Exits ")
)
)
)
(wcconfig "checkout" 1.0 "Evaluate the next AutoLISP expression")
;;;ETOS function from Inside Autolisp
(defun etos (arg / file)
(if (= 'STR (type arg))
(setq arg (strcat "\"" arg "\""))
)
(setq file (open "$" "w"))
(princ arg file)
(close file)
(setq file (open "$" "r"))
(setq arg (read-line file))
(close file)
(close (open "$" "w"))
arg
);defun
;This function is for direct access to AutoLISP.
(defun eval_func (/ rep tmp)
(if (not _last_eval_)
(setq _last_eval_ "")
)
(setq rep (wc_fetch_string _last_eval_ "Enter function to evaluate:" ""))
(if rep
(progn
(setq _last_eval_ rep)
(setq tmp (eval (read rep)))
(if tmp
(progn
(setq tmp (etos tmp)) ; converts whatever is returned to a string
(if tmp
(wc_fetch_string tmp "Lisp evaluation returned: " "Press <ESC> to continue" )
)
)
)
)
)
)
(wcconfig "eval_func" 1.0 "Access AutoLISP directly")
;;;This routine is used for returning the scancode value of a key pressed. The
;;;routine will ask you for a string/comment of the key and then ask you to
;;;hit that key. It will then place the scancode value for that key at the
;;;current cursor position followed by ');' and the comment previously typed
;;;in. This function should be played with to obtain a method which is
;;;comfortable for you.
(defun getcode();/ lst str key line col SS)
(WC_refresh 0)
(if (not _last_code_name_)
(setq _last_code_name_ "")
)
(setq lst(WC_statistics))
(setq line(WC_row -1.0))
(setq col (WC_col -1.0))
(setq key(WC_message "Hit key --> " 0))
(setq sS (wc_gname key))
(if ss
(setq str(strcat " (WC_gkey \""(wc_gname key) "\")" ))
(setq str (RTOS key 2 0))
)
(WC_silent 0)
(WC_trigger "INSERT_LINE_A")
(WC_replace_line str);Replaces the line
(WC_race_home 0)
(WC_trigger "BEGIN_COL_MARK") ;Set a line mark
(WC_race_end 0)
(WC_trigger "END_MARK") ;Set the end mark
(WC_trigger "BCUT") ;Save the marked text
(WC_row line)
(WC_col col)
(WC_move_down 1.0)
(WC_trigger "DUMP_SCRAP")
(WC_row line )
(WC_col col)
(WC_trigger "DELETE_LINE")
(WC_refresh 0)
(prin1)
)
(wcconfig "getcode" 1.0 "Insert the ascii/scan code for a key")
;;;This function will do the following:
;;; 1.)Check all brackets.
;;; 2.)If brackets are ok, then write the file to disk.
;;; 3.)If 1 and 2 are ok then load the file.
(defun force_load(/ lst ls sd fname oldcomm oldjump check);This routine is used to
(setq lst(WC_STATISTICS)) ;assist you in your lisp
(if lst ;developemnt. While writing
(progn ;your code you may hit CNT_L
(setq sd(nth 14 lst)) ;and your function will be
(setq fname (gcname)) ;bracket/string checked,
;saved to file and loaded
;back into AutoCAD.
;Use the function 'add_name'
;F8 to place your routine on
(if (not _IGNORE_)
(setq check(WC_trigger "DO_ALL_BRACKET"))
)
(if( = check 1)
(progn
(WC_message (strcat "Please wait loading " fname) 1)
(WC_HARD_WRITE)
(load fname "WCerr")
(WC_refresh 1)
(WC_print (strcat fname " is reloaded"))
;(wc_trigger "QUIT") Optional
)
(WC_message "Unmatch parenthesis!" 0)
)
)
)
)
(wcconfig "force_load" 1.0 "Inspect write and load the current AutoLISP file")
;;; add_name <currently assigned to F8> now selects a default function
;;; name as the first name after the first defun found from the current
;;; cursor position. Simply place the cursor on the line , or above,
;;; of the function and hit F8. Add_name should find the appropriate
;;; name to use for the default or nothing if it could not find a
;;; a 'defun'. REGISTER.
(defun add_name(/ flag str a)
(WC_race_home 0)
(setq flag 't)
; (WC_set_words 41 125); <<-- Excludes any parenthesis
(setq oldcase(WC_getvar "TOCASE"))
(WC_setvar "tocase" 0)
(if( = (wc_find "defun") 1)
(progn
(setq str(WC_next_word))
(WC_setvar "tocase" oldcase)
(setq str(WC_FETCH_STRING str " Enter Lisp name " ""))
(if str
(progn
(setq a(WC_message "Enter Your Define key" 0))
;(setq a(atoi(rtos a 2 2)));Forces to int if it's a real
(if (and a(/= a (wc_gkey "Escape")))
(progn
(WCconfig str a)
(if (not(eval(read str))) ;Test to see if it is defined
(WC_message "You must load before activating!" 0)
)
(WC_message "Function is Registered" 0);
)
(progn
(if (= a (wc_gkey "Escape"))
(WC_print "User canceled")
)
(if (> (strlen (WC_castchar a)) 0)
(WC_message "Should not use alfa numeric keys for defines" 0)
)
)
)
)
)
)
)
)
(wcconfig "add_name" 1.0 "Register the next function to WCEdit")
;;;I like to use this function to "kick" strings to the right since
;;;I prefer working with insert mode off. The routine will place
;;;the current tabwidth's amount of spaces at the cursor position.
(defun intab(/ mode str tabw ch)
(setq mode(WC_getvar "insert_mode") str "" tabw (WC_getvar "TABWIDTH"))
(WC_silent 1)
(wc_race_home 0)
; (wc_trigger "NEXT_WORD")
(WC_pad_left tabw)
(WC_move_down 1.0)
(WC_race_home 0.0)
(WC_silent 0)
(WC_refresh 0);Resets silent to 0
)
(wcconfig "intab" 1.0 "Insert TABWIDTH spaces at left of line")
(defun zap_curr(old / lst num i nme )
(setq lst(wc_statistics) num(nth 13 lst) i (nth 18 lst))
(if(< num 2)
(progn
(wc_silent 0)
(wc_message "Attempt to delete buffer incorrect buffer" 0)
(quit)
)
)
(wc_new_file old)
(if ( > num 1)
(progn
(wc_remove_buffer i)
)
)
)
(defun ins_crr()
(wc_break_line)
(wc_add_string "\n")
(wc_wrap_up)
)
(defun print_file( ) ; / row col fstat len is OLDF crow flag )
(setq row (wc_row -1.0)col (wc_col -1.0) fstat(wc_statistics)
is(nth 3 fstat) oldf(gcname) len (nth 2 fstat)
crow 0 flag 't down 60 page 1 page_st 50
)
;(textscr)
;(wc_cls)
(wc_window 20 1 60 6 1 1)
(wc_display 21 2 " The print options available do not" )
(wc_display 21 3 " affect the current file. All pre-")
(wc_display 21 4 " processing is done in a spare buffer." )
(wc_display 21 5 " Only text mode printing is supported." )
(setq pconf(list 66 "NO" 50 "PRN" 5 3 3) flag 't a 0)
(while flag
(setq a
(wc_tmenu "══════ Print options Editor ══════" a
(list
(strcat " Lines per page: " (itoa (nth 0 pconf))) ;0
(strcat " Include page numbers: " (nth 1 pconf)) ;1
(strcat " Column for page #: "(itoa (nth 2 pconf))) ;2
(strcat " Sent file to: "(nth 3 pconf)) ;3
(strcat " Left margin: "(itoa (nth 4 pconf))) ;4
(strcat " Top margin: "(itoa (nth 5 pconf))) ;5
(strcat " Bottom margin: "(itoa (nth 6 pconf))) ;6
"Print the file "
"Exit to exitor "
)
)
)
(cond
((= a 0)
(setq tempi(wc_fetch_int " Enter lines per page: " 3 (nth 0 pconf)))
(if (> tempi 0)
(setq pconf(list tempi (nth 1 pconf) (nth 2 pconf)(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
)
)
((= a 1)
(if(= (nth 1 pconf) "NO")
(setq pconf(list (nth 0 pconf) "YES" (nth 2 pconf)(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
(setq pconf(list (nth 0 pconf) "NO" (nth 2 pconf)(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
)
)
((= a 2)
(setq tempi(wc_fetch_int " Enter Column for page #: " 3 (nth 2 pconf)))
(if (> tempi 0)
(setq pconf(list (nth 0 pconf)(nth 1 pconf) tempi(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
)
)
((= a 3)
(setq opt
(list
"PRN"
"LPT1"
"LPT2"
)
)
(cond
((= (nth 3 pconf)(nth 0 opt))
(setq opt_def 0)
)
((= (nth 3 pconf)(nth 1 opt))
(setq opt_def 1)
)
((= (nth 3 pconf)(nth 2 opt))
(setq opt_def 2)
)
)
(setq k
(wc_tmenu " Printer output " opt_def
(setq opt
(list
"PRN"
"LPT1"
"LPT2"
)
)
)
)
(if ( and (< k 3)(>= k 0))
(progn
(setq pconf(list (nth 0 pconf)(nth 1 pconf) tempi(nth k opt)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
)
)
)
((= a 4);Left margin
(setq tempi(wc_fetch_int " Enter Left Margin: " 3 (nth 4 pconf)))
(if (>= tempi 0)
(setq pconf(list (nth 0 pconf)(nth 1 pconf)(nth 2 pconf)(nth 3 pconf)tempi(nth 5 pconf)(nth 6 pconf)))
)
)
((= a 5);Top margin
(setq tempi(wc_fetch_int " Enter Top Margin: " 3 (nth 5 pconf)))
(if (>= tempi 0)
(setq pconf(list (nth 0 pconf)(nth 1 pconf)(nth 2 pconf)(nth 3 pconf)(nth 4 pconf)tempi(nth 6 pconf)))
)
)
((= a 6);Bot margin
(setq tempi(wc_fetch_int " Enter Bottom Margin: " 3 (nth 6 pconf)))
(if (>= tempi 0)
(setq pconf(list (nth 0 pconf)(nth 1 pconf)(nth 2 pconf)(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)tempi))
)
)
((= a 7)
(wc_message "Printing. Please wait..." 1)
(setq flag 't)
(if(= (nth 3 fstat) 0)
(progn
(wc_race_home 2)
(wc_trigger "BEGIN_LINE_MARK")
(wc_race_end 2)
(wc_trigger "END_MARK")
)
)
(setq down(nth 0 pconf))
(setq page_st(nth 2 pconf))
(setq page(nth 0 pconf))
(wc_trigger "DUMP_TO_SCRAP")
(wc_new_file "$TRASH$")
(wc_flush_buffer)
;(wc_setvar "LAST_SCRAP" 1)
(wc_trigger "DUMP_SCRAP")
(if(> (nth 4 pconf) 0)
(repeat (atoi(rtos (nth 2 (wc_statistics)) 2 2));(nth 2 (wc_statistics))
(wc_pad_left (nth 4 pconf))
(wc_move_down 1.0)
)
)
(wc_race_home 2)
(setq len(nth 2 (wc_statistics))crow(wc_row -1.0))
(wc_col 0.0)
(while flag
(repeat(nth 5 pconf);Top margin
(ins_crr)
(wc_move_right 1.0)
)
(wc_stuff_char (wc_castchar 13))
(wc_move_down (atof(rtos(- page (+ (nth 6 pconf)(nth 5 pconf)))2 2)))
(setq crow(wc_row -1.0))
(if (<= crow len)
(progn
(wc_col 0.0)
(wc_stuff_char (wc_castchar 12))
(wc_move_right 1.0)
)
(setq flag nil)
)
)
(wc_race_home 2)
(wc_trigger "BEGIN_LINE_MARK")
(wc_race_end 2)
(wc_trigger "END_MARK")
(wc_trigger "DUMP_TO_SCRAP")
(wc_write_scrap (nth 3 pconf))
(zap_curr oldf)
(wc_row row)
(wc_col col)
(WC_refresh 1)
(setq flag nil)
)
(t
(setq flag nil)
)
)
)
)
(wcconfig "print_FILE" 1.0 "Print the file or marked block")
;;;This program will create an AutoLISP program for the current
;;;macro defined. The output is placed into macs.lsp.
(defun create_lisp( / row col oldf flag len lst str is i crow key
name desc ans ll)
(setq row (wc_row -1.0)col (wc_col -1.0) lst(wc_statistics)
is(nth 3 lst) oldf(gcname) len (nth 2 lst)
crow 0 flag 't
)
(setq lst(wc_get_macro))
(setq key(wc_message "Hit the key to assign" 0))
(if (/= key 283.0)
(progn
(setq name(wc_fetch_string "" " Enter a macro name " ""))
(setq desc(wc_fetch_string "" " Enter a description " ""))
(if (and name desc)
(progn
(wcconfig name key desc)
(wc_new_file "$TRASH$")
(wc_flush_buffer)
(wc_replace_line (strcat ";;;Macro: " desc))
(wc_move_down 1.0)
(wc_replace_line (strcat "(defun " name "(/ lst index)"))
(wc_move_down 1.0)
(wc_replace_line "(setq index 0 lst (list" )
(wc_move_down 1.0)
(setq index 0)
(repeat (length lst)
(setq ll(wc_gfunc (nth index lst))str(wc_gname (nth index lst)))
(if(not str)
(setq str "Unknown key")
)
(if ll
(wc_replace_line (strcat "(wc_first_key \"" (nth 1 ll) "\")" ))
(wc_replace_line (strcat (rtos (nth index lst) 2 1) " ;;;" str ))
)
(wc_pad_left (* 3 (wc_getvar "TABWIDTH")))
(wc_move_down 1.0)
(setq index(+ 1 index))
)
(wc_replace_line "))")
(wc_move_down 1.0)
(wc_replace_line "(repeat (length lst)")
(wc_move_down 1.0)
(wc_replace_line "(wc_stuffkey (nth index lst))")
(wc_move_down 1.0)
(wc_replace_line "(setq index(+ 1 index))")
(wc_move_down 1.0)
(wc_replace_line ")")
(wc_move_down 1.0)
(wc_replace_line ");;;End macro")
(wc_move_down 1.0)
(wc_replace_line (strcat "(wcconfig \"" name "\" 1.0 \"" desc"\");;;Window register."))
(wc_trigger "PPRINT_ALL")
(wc_race_home 2)
(wc_trigger "BEGIN_LINE_MARK")
(wc_race_end 2)
(wc_trigger "END_MARK")
(wc_trigger "DUMP_TO_SCRAP")
(wc_flush_buffer)
(zap_curr oldf)
(if(setq str(findfile "MACS.LSP"))
(WC_new_file str)
(WC_new_file "MACS.LSP")
)
(wc_race_end 2)
(wc_move_down 2.0)
(wc_trigger "DUMP_SCRAP")
(wc_trigger "UHARD")
(load "MACS")
(zap_curr oldf)
(wc_row row)
(wc_col col)
(wc_message "Key is assigned and MACS.LSP is appended" 0)
)
)
)
)
)
(wcconfig "create_lisp" 1.0 "Create Lisp file from current macro.")
(defun rem_trail(str / i ch outstr)
(wc_trimends str)
)
(defun c:shll()
(if(not __last_shll)
(setq __last_shll "")
)
(setq par(wc_fetch_string __last_shll " Enter DOS command " ""))
(if par
(progn
(if par
(setq par(rem_trail par))
)
(wc_cls)
(setvar "cmdecho" 0)
(setq emode (nth 19 (wc_statistics)))
(setq mouse (wc_getvar "UMOUSE"))
(wc_mouse 0)
(if(or(= emode 50)(= emode 43))
(wc_setmode_now 0)
)
(wc_cls)
(wc_setcurs 1 1)
(if par
(progn
(setq __last_shll par)
(command "sh" par)
)
(progn
(command "sh" "")
)
)
(wc_message "Press any key to return" 0)
(if(or(= emode 50)(= emode 43))
(progn
(wc_setmode_now 1)
(wc_setvar "UMOUSE" mouse)
(wc_mouse mouse)
)
)
(wc_refresh 1)
)
)
(prin1)
)
(wcconfig "C:shll" 1.0 "Shell to DOS.")
(defun dispkey(i);0 trigger,1 External
(setq lst (wc_gfunc i))
(if lst
(progn
(if (= (nth 0 lst) 1)
(setq str "<E> ")
(setq str "")
)
(setq str (strcat str (nth 1 lst) " - " (nth 2 lst)))
(wc_message str 0)
)
(wc_message "Unknown" 0)
)
(prin1)
)
(prin1)